home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pcxsee.zip / SHOWPCX.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-23  |  29KB  |  877 lines
  1. {$R-}                             {Range checking off}
  2. {$B-}                             {Boolean complete evaluation off}
  3. {$S-}                             {Stack checking off}
  4. {$I+}                             {I/O checking on}
  5. {$N-}                             {No numeric coprocessor}
  6.  
  7. UNIT ShowPCX;
  8.  
  9. {*************************************************************************}
  10. {                                                                         }
  11. { This unit reads a PC Paintbrush PCX file and shows it on the screen.    }
  12. { The picture may have 2,4 16 or 256 colors and be CGA, EGA, MCGA or VGA. }
  13. { The picture will be displayed until a key is pressed.                   }
  14. {                                                                         }
  15. { This unit is based on a demo program (SHOW_PCX) downloaded from the BBS }
  16. { operated by Zsoft, the publisher of PC Paintbrush and the developer of  }
  17. { the PCX picture format.                                                 }
  18. {                                                                         }
  19. { Note:  Many, many paint and draw programs can read and write PCX files. }
  20. {        So, this unit is not restricted to just users of PC Paintbrush.  }
  21. {                                                                         }
  22. {*************************************************************************}
  23.  
  24. INTERFACE
  25.  
  26. USES
  27.   OpCrt, Dos;
  28.  
  29. TYPE
  30.   str80 = String[80];
  31.  
  32. PROCEDURE ShowPicture(PicName : str80); {Only "Public" PROCEDURE}
  33.  
  34. IMPLEMENTATION
  35.  
  36. CONST
  37.   MAX_WIDTH = 4000;               { arbitrary - maximum width (in bytes) of a PCX image }
  38.   COMPRESS_NUM = $C0;             { this is the upper two bits that indicate a count }
  39.   MAX_BLOCK = 4096;
  40.  
  41.   RED = 0;
  42.   GREEN = 1;
  43.   BLUE = 2;
  44.  
  45. {   The following display modes are supported:
  46.  
  47.   "Type"  Mode      Graphics Card       Resolution    Colors
  48.   ~~~~~~  ~~~~      ~~~~~~~~~~~~~       ~~~~~~~~~~    ~~~~~~ }
  49.   CGA04 = $04;     { CGA                320 x 200         4 }
  50.   CGA06 = $06;     { CGA                640 x 200         2 }
  51.   EGA0D = $0D;     { EGA                320 x 200        16 }
  52.   EGA0E = $0E;     { EGA                640 x 200        16 }
  53.   EGA10 = $10;     { EGA                640 x 350        16 }
  54.   VGA12 = $12;     { VGA                640 x 480        16 }
  55.   VGA13 = $13;     { VGA                320 x 200       256 }
  56.  
  57. {  Mode $13 is supported only for files containing 256 color palette
  58. information,
  59.    i.e. not those produced by versions of Paintbrush earlier than 3.0. }
  60.  
  61.  
  62. TYPE
  63.   file_buffer = ARRAY[0..127] OF Byte;
  64.   block_array = ARRAY[0..MAX_BLOCK] OF Byte;
  65.   pal_array = ARRAY[0..255, RED..BLUE] OF Byte;
  66.   ega_array = ARRAY[0..16] OF Byte;
  67.   line_array = ARRAY[0..MAX_WIDTH] OF Byte;
  68.   EGAColorTriples = ARRAY[0..15, RED..BLUE] OF Byte;
  69.                     { RGB palette data (16 colors or less)
  70.                      256 color palette is appended to end of file }
  71.  
  72.   pcx_header = RECORD
  73.                  Manufacturer : Byte; { Always 10 for PCX file }
  74.  
  75.                  Version : Byte;  { 0 - old PCX - Version 2.5 (not used anymore),
  76.                                   2 - Version 2.8 - With palette info,
  77.                                   3 - Version 2.8 - Without palette info,
  78.                                   4 - Microsoft Windows - no palette (only in
  79.                                       old files, new Windows uses Version 3.0),
  80.                                   5 - Version 3.0 with palette }
  81.  
  82.                  Encoding : Byte; { 1 is PCX, it is possible that we may add
  83.                                   additional encoding methods in the future }
  84.  
  85.                  Bits_per_pixel : Byte; { Number of bits to represent a pixel
  86.                                   (per plane) - 1, 2, 4, or 8 }
  87.  
  88.                  Xmin : Integer;  { Image window dimensions (inclusive) }
  89.                  Ymin : Integer;  { Xmin, Ymin are usually zero (not always) }
  90.                  Xmax : Integer;
  91.                  Ymax : Integer;
  92.  
  93.                  Hdpi : Integer;  { Resolution of image (dots per inch) }
  94.                  Vdpi : Integer;  { Set to scanner resolution - 300 is default }
  95.  
  96.                  ColorMap : EGAColorTriples;
  97.                                 { RGB palette data (16 colors or less)
  98.                                   256 color palette is appended to end of file }
  99.  
  100.                  Reserved : Byte; { (used to contain video mode)
  101.                                   now it is ignored - just set to zero }
  102.  
  103.                  Nplanes : Byte;  { Number of planes }
  104.  
  105.                  Bytes_per_line_per_plane : Integer; { Number of bytes to allocate
  106.                                                for a scanline plane.
  107.                                                MUST be an an EVEN number!
  108.                                                Do NOT calculate from Xmax-Xmin! }
  109.  
  110.                  PaletteInfo : Integer; { 1 = black & white or color image,
  111.                                   2 = grayscale image - ignored in PB4, PB4+
  112.                                   palette must also be set to shades of gray! }
  113.  
  114.                  HscreenSize : Integer; { added for PC Paintbrush IV Plus ver 1.0,  }
  115.                  VscreenSize : Integer; { PC Paintbrush IV ver 1.02 (and later)     }
  116.                                 { I know it is tempting to use these fields
  117.                                   to determine what video mode should be used
  118.                                   to display the image - but it is NOT
  119.                                   recommended since the fields will probably
  120.                                   just contain garbage. It is better to have
  121.                                   the user install for the graphics mode he
  122.                                   wants to use... }
  123.  
  124.                  Filler : ARRAY[74..127] OF Byte; { Just set to zeros }
  125.                END;
  126.  
  127. VAR
  128.   Name : str80;                   { Name of PCX file to load }
  129.   ImageName : str80;              { Name of PCX file - used by ReadError }
  130.   BlockFile : FILE;               { file for reading block data }
  131.   BlockData : block_array;        { 4k data buffer }
  132.  
  133.   Header : pcx_header;            { PCX file header }
  134.   Palette256 : pal_array;         { place to put 256 color palette }
  135.   PaletteEGA : ega_array;         { place to put 16 EGA palette values }
  136.   PCXline : line_array;           { place to put uncompressed data }
  137.  
  138.   Ymax : Integer;                 { maximum Y value on screen }
  139.   NextByte : Integer;             { index into file buffer in ReadByte }
  140.   Index : Integer;                { PCXline index - where to put Data }
  141.   Data : Byte;                    { PCX compressed data byte }
  142.  
  143.   PictureMode : Integer;          { Graphics mode number }
  144.   Reg : Registers;                { Register set - used for int 10 calls }
  145.   Colors : Integer;               { Number of Colors in picture}
  146.   Xoffset : Integer;              { Offset used to "center" picture }
  147.   Center : Boolean;               { Flag used to decide on "centering" }
  148.   Xsize, Ysize : Integer;         { Size of "default" screen for picture }
  149.   PicXsize, PicYsize : Integer;   { Size of picture }
  150.   UseDefaultPalette : Boolean;
  151.  
  152. CONST
  153.  
  154.   EGATriplet : EGAColorTriples = ( { 48byte default EGA/VGA palette}
  155.     ($00, $00, $00),              {  black        }
  156.     ($00, $00, $AA),              {  blue         }
  157.     ($00, $AA, $00),              {  green        }
  158.     ($00, $AA, $AA),              {  cyan         }
  159.     ($AA, $00, $00),              {  red          }
  160.     ($AA, $00, $AA),              {  magenta      }
  161.     ($AA, $55, $00),              {  brown        }
  162.     ($AA, $AA, $AA),              {  lightgray    }
  163.     ($55, $55, $55),              {  darkgray     }
  164.     ($00, $00, $FF),              {  lightblue    }
  165.     ($00, $FF, $00),              {  lightgreen   }
  166.     ($00, $FF, $FF),              {  lightcyan    }
  167.     ($FF, $00, $00),              {  lightred     }
  168.     ($FF, $00, $FF),              {  lightmagenta }
  169.     ($FF, $FF, $00),              {  yellow       }
  170.     ($FF, $FF, $FF));             {  white        }
  171.  
  172.   { ================================= Error ================================== }
  173.  
  174.   PROCEDURE Error(s : str80);
  175.  
  176.     { Print out the error message and wait, then halt }
  177.  
  178.   VAR c : Char;
  179.     i : Integer;
  180.  
  181.   BEGIN
  182.     TextMode(C80);
  183.     WriteLn('ERROR');
  184.     WriteLn(s);
  185.     Halt;
  186.   END;                            { Error }
  187.  
  188.  
  189.   { =============================== ReadError =============================== }
  190.  
  191.   PROCEDURE ReadError(msg : Integer);
  192.  
  193.     { Check for an i/o error }
  194.  
  195.   BEGIN
  196.     IF IoResult <> 0 THEN
  197.       CASE msg OF
  198.         1 : Error('Can''t open file - '+ImageName);
  199.         2 : Error('Error closing file - '+ImageName+' - disk may be full');
  200.         3 : Error('Error reading file - '+ImageName);
  201.  
  202.       ELSE
  203.         Error('Error doing file I/O - '+ImageName);
  204.       END;                        { case }
  205.   END;                            { ReadError }
  206.  
  207.   { =========================== VideoMode =============================== }
  208.  
  209.   PROCEDURE VideoMode(n : Integer);
  210.  
  211.     { Do a BIOS call to set the video mode }
  212.     { In Turbo Pascal, a '$' means the number is hexadeximal. }
  213.  
  214.   BEGIN
  215.  
  216.     Reg.ah := $00;
  217.     Reg.al := n;                  { mode number }
  218.     intr($10, Reg);               { call interrupt }
  219.   END;                            { VideoMode }
  220.  
  221.   { =========================== CGApalette =============================== }
  222.  
  223.   PROCEDURE CGApalette;
  224.  
  225.     { Set the CGA 4 color palette. }
  226.     { In Turbo Pascal, a '$' means the number is hexadeximal. }
  227.  
  228.   VAR
  229.     BackGround, ForeGround, Palette : Byte;
  230.  
  231.     Intense : Boolean;
  232.  
  233.   BEGIN
  234.     BackGround := Header.ColorMap[0, RED]SHR 4;
  235.     { Top four bits of first BYTE of Color map represent Background color }
  236.  
  237.     ForeGround := Header.ColorMap[1, RED]SHR 5;
  238.     { Top three bits of fourth BYTE of Color map defines Foreground colors }
  239.     { Where Bit = 0 -- is Intensity (0 = Dim, 1 = Bright) }
  240.     { Where Bit = 1 -- is Palette (0 = Red-Green-Brown,
  241.                                    1 = Cyan-Magenta-White) }
  242.     { Where Bit = 2 -- is "BurstEnable" (0 = Color, 1 = Mono) }
  243.  
  244.     Palette := ForeGround AND 2;
  245.     IF (ForeGround AND 1) = 1
  246.     THEN Intense := True
  247.     ELSE Intense := False;
  248.  
  249.     IF Intense THEN
  250.       BEGIN
  251.         IF Palette = 1
  252.         THEN Palette := 3         {Light Cyan - Light Magenta - White}
  253.         ELSE Palette := 1;        {Cyan - Magenta - White}
  254.       END
  255.     ELSE BEGIN
  256.       IF Palette = 0
  257.       THEN Palette := 2           {Light Green - Light Red - Yellow}
  258.       ELSE Palette := 0;          {Green - Red - Brown}
  259.     END;
  260.  
  261.     { First -- Set CGA Palette }
  262.     Reg.ah := $0B;                { Set CGA Palette }
  263.     Reg.bh := $01;                { set palette }
  264.     Reg.bl := Palette;            { set palette }
  265.     intr($10, Reg);               { call interrupt }
  266.  
  267.     { Now -- Set Background Color }
  268.     Reg.ah := $0B;                { Set CGA Palette }
  269.     Reg.bh := $00;                { set Background }
  270.     Reg.bl := BackGround;         { set BackGround color }
  271.     intr($10, Reg);               { call interrupt }
  272.  
  273.   END;                            { CGApalette }
  274.  
  275.  
  276.   { =========================== EGA16palette =============================== }
  277.  
  278.   PROCEDURE EGA16palette;
  279.  
  280.     { Set the EGA's entire 16 color palette. }
  281.     { In Turbo Pascal, a '$' means the number is hexadeximal. }
  282.  
  283.   VAR
  284.     i, r, g, b : Integer;
  285.  
  286.   BEGIN
  287.     FOR i := 0 TO 15 DO
  288.       BEGIN
  289.         r := Header.ColorMap[i, RED]SHR 6; { r, g, and b are now 0..3 }
  290.         g := Header.ColorMap[i, GREEN]SHR 6;
  291.         b := Header.ColorMap[i, BLUE]SHR 6;
  292.         PaletteEGA[i] := (r SHL 4)+(g SHL 2)+b;
  293.       END;
  294.     PaletteEGA[16] := 0;          { border color }
  295.  
  296.     Reg.ah := $10;                { Set Palette Call }
  297.     Reg.al := $02;                { set a block of palette registers }
  298.     Reg.dx := Ofs(PaletteEGA);    { offset of block }
  299.     Reg.es := Seg(PaletteEGA);    { segment of block }
  300.     intr($10, Reg);               { call interrupt }
  301.  
  302.   END;                            { EGA16palette }
  303.  
  304.  
  305.   { =========================== VGA16palette =============================== }
  306.  
  307.   PROCEDURE VGA16palette;
  308.  
  309.     { Set the VGA's entire 16 color palette. }
  310.     { In Turbo Pascal, a '$' means the number is hexadeximal. }
  311.  
  312.   VAR
  313.     i : Integer;
  314.  
  315.   BEGIN
  316.     FOR i := 0 TO 15 DO
  317.       PaletteEGA[i] := i;
  318.     PaletteEGA[16] := 0;          { border color }
  319.  
  320.     Reg.ah := $10;                { Set Palette Call }
  321.     Reg.al := $02;                { set a block of palette registers }
  322.     Reg.dx := Ofs(PaletteEGA);    { offset of block }
  323.     Reg.es := Seg(PaletteEGA);    { segment of block }
  324.     intr($10, Reg);               { call interrupt }
  325.  
  326.     FOR i := 0 TO 15 DO
  327.       BEGIN                       { R, G, and B must be 0..63 }
  328.         Palette256[i, RED] := Header.ColorMap[i, RED]SHR 2;
  329.         Palette256[i, GREEN] := Header.ColorMap[i, GREEN]SHR 2;
  330.         Palette256[i, BLUE] := Header.ColorMap[i, BLUE]SHR 2;
  331.       END;
  332.  
  333.     Reg.ah := $10;                { Set DAC Call }
  334.     Reg.al := $12;                { set a block of DAC registers }
  335.     Reg.bx := 0;                  { first DAC register number }
  336.     Reg.cx := 255;                { number of registers to update }
  337.     Reg.dx := Ofs(Palette256);    { offset of block }
  338.     Reg.es := Seg(Palette256);    { segment of block }
  339.     intr($10, Reg);               { call interrupt }
  340.  
  341.   END;                            { VGA16palette }
  342.  
  343.  
  344.   { ===================== SetDefaultPalette =============================== }
  345.  
  346.   PROCEDURE SetDefaultPalette;
  347.  
  348.     { Set the CGA/EGA/VGA 4 or 16 color palette to the "default" values. }
  349.  
  350.   BEGIN
  351.     Header.ColorMap := EGATriplet; { 48 byte default EGA/VGA palette }
  352.  
  353.     IF CurrentDisplay = EGA THEN EGA16palette;
  354.     IF CurrentDisplay = VGA THEN VGA16palette;
  355.  
  356.     IF (CurrentDisplay = CGA) AND(PictureMode = CGA04) THEN
  357.       BEGIN
  358.  
  359.         { First -- Set CGA Palette }
  360.         Reg.ah := $0B;            { Set CGA Palette }
  361.         Reg.bh := $01;            { set palette }
  362.         Reg.bl := 1;              { set palette to Cyan - Magenta - White}
  363.         intr($10, Reg);           { call interrupt }
  364.  
  365.         { Now -- Set Background Color }
  366.         Reg.ah := $0B;            { Set CGA Palette }
  367.         Reg.bh := $00;            { set Background }
  368.         Reg.bl := 0;              { set BackGround color to Black}
  369.         intr($10, Reg);           { call interrupt }
  370.       END;
  371.  
  372.   END;                            { SetDefaultPalette }
  373.  
  374.  
  375.   { =========================== EntireVGApalette =============================== }
  376.  
  377.   PROCEDURE EntireVGApalette;
  378.  
  379.     { Set the VGA's entire 256 color palette. }
  380.     { In Turbo Pascal, a '$' means the number is hexadeximal. }
  381.  
  382.   VAR
  383.     i : Integer;
  384.  
  385.   BEGIN
  386.     FOR i := 0 TO 255 DO
  387.       BEGIN                       { R, G, and B must be 0..63 }
  388.         Palette256[i, RED] := Palette256[i, RED]SHR 2;
  389.         Palette256[i, GREEN] := Palette256[i, GREEN]SHR 2;
  390.         Palette256[i, BLUE] := Palette256[i, BLUE]SHR 2;
  391.       END;
  392.  
  393.     Reg.ah := $10;                { Set DAC Call }
  394.     Reg.al := $12;                { set a block of DAC registers }
  395.     Reg.bx := 0;                  { first DAC register number }
  396.     Reg.cx := 255;                { number of registers to update }
  397.     Reg.dx := Ofs(Palette256);    { offset of block }
  398.     Reg.es := Seg(Palette256);    { segment of block }
  399.     intr($10, Reg);               { call interrupt }
  400.  
  401.   END;                            { EntireVGApalette }
  402.  
  403.  
  404.   { =========================== SetPalette =============================== }
  405.  
  406.   PROCEDURE SetPalette;
  407.  
  408.     { Set up the entire graphics palette }
  409.  
  410.   VAR i : Integer;
  411.  
  412.   BEGIN
  413.  
  414.     {Don't set or reset palette for $0E and $0F modes}
  415.     {This is an "undocumented quirk" of the .PCX standard}
  416.     IF NOT (PictureMode IN[EGA0D, EGA0E]) THEN
  417.  
  418.     {Use Default palette if last character of picture file name is underscore}
  419.     IF UseDefaultPalette
  420.     THEN SetDefaultPalette
  421.     ELSE BEGIN                    {Set Special Palette}
  422.  
  423.       IF PictureMode = VGA13 THEN
  424.         IF (CurrentDisplay IN[VGA, PGC, MCGA])
  425.         THEN EntireVGApalette
  426.         ELSE Error('Mode not supported');
  427.  
  428.       IF (PictureMode = VGA12) THEN
  429.         IF (CurrentDisplay IN[EGA, VGA, PGC, MCGA])
  430.         THEN VGA16palette
  431.         ELSE Error('Mode not supported');
  432.  
  433.       IF (PictureMode = EGA10) THEN
  434.         IF (CurrentDisplay IN[VGA, PGC, MCGA])
  435.         THEN VGA16palette
  436.         ELSE IF (CurrentDisplay = EGA)
  437.         THEN EGA16palette
  438.         ELSE Error('Mode not supported');
  439.  
  440.       IF PictureMode IN[CGA04, CGA06] THEN
  441.         IF (CurrentDisplay = MonoHerc)
  442.         THEN Error('Mode not supported')
  443.         ELSE IF PictureMode = CGA04
  444.         THEN CGApalette;
  445.  
  446.     END;                          {Set Special Palette}
  447.  
  448.   END;                            { SetPalette }
  449.  
  450.  
  451.   { =========================== ShowCGA =============================== }
  452.  
  453.   PROCEDURE ShowCGA(Y : Integer);
  454.  
  455.     { Put a line of CGA data on the screen }
  456.     { In Turbo Pascal, a '$' means the number is hexadeximal. }
  457.  
  458.   VAR
  459.     i, j, l, m, t : Integer;
  460.     Yoffset : Integer;
  461.     CGAScreen : ARRAY[0..32000] OF Byte ABSOLUTE $B800 : $0000;
  462.  
  463.   BEGIN
  464.     i := 8 DIV Header.Bits_per_pixel; { i is pixels per byte }
  465.  
  466.     IF (i = 8) THEN               { 1 bit per pixel }
  467.       j := 7
  468.     ELSE                          { 2 bits per pixel }
  469.       j := 3;
  470.  
  471.     t := (Header.Xmax-Header.Xmin+1); { width in pixels }
  472.     m := t AND j;                 { left over bits }
  473.  
  474.     l := (t+j) DIV i;             { compute number of bytes to display }
  475.     IF l > 80 THEN
  476.       BEGIN
  477.         l := 80;                  { don't overrun screen width }
  478.         m := 0;
  479.       END;
  480.  
  481.     IF (m <> 0) THEN              { we need to mask unseen pixels }
  482.       BEGIN
  483.         m := $FF SHL(8-(m*Header.Bits_per_pixel)); { m = mask }
  484.         t := l-1;
  485.         PCXline[t] := PCXline[t]AND m; { mask off unseen pixels }
  486.       END;
  487.  
  488.     Xoffset := 0;
  489.     IF Center THEN Xoffset := (80-l) DIV 2; { Offset to "center" picture }
  490.  
  491.     Yoffset := 8192*(Y AND 1);
  492.     Move(PCXline[0], CGAScreen[((Y SHR 1)*80)+Yoffset+Xoffset], l);
  493.  
  494.   END;                            { ShowCGA }
  495.  
  496.  
  497.   { =========================== ShowEGA =============================== }
  498.  
  499.   PROCEDURE ShowEGA(Y : Integer);
  500.  
  501.     { Put a line of EGA (or VGA) data on the screen }
  502.     { In Turbo Pascal, a '$' means the number is hexadeximal. }
  503.  
  504.   VAR
  505.     i, j, l, m, t : Integer;
  506.     EGAplane : Integer;
  507.     EGAscreen : ARRAY[0..32000] OF Byte ABSOLUTE $A000 : $0000;
  508.  
  509.   BEGIN
  510.     EGAplane := $0100;            { the first plane to update }
  511.     PortW[$3CE] := $0005;         { use write mode 0 }
  512.  
  513. { PortW [$3CE] := $0005;      does port I/O by words. It is the same as:
  514.  
  515.   Out 03CEh,05h
  516.   Out 03CFh,00h
  517. }
  518.  
  519.     t := (Header.Xmax-Header.Xmin+1); { width in pixels }
  520.     m := t AND 7;                 { left over bits }
  521.  
  522.     l := (t+7) SHR 3;             { compute number of bytes to display }
  523.     IF (l >= 80) THEN
  524.       BEGIN
  525.         l := 80;                  { don't overrun screen width }
  526.         m := 0;
  527.       END;
  528.  
  529.     IF (m <> 0) THEN
  530.       m := $FF SHL(8-m)           { m = mask for unseen pixels }
  531.     ELSE
  532.       m := $FF;
  533.  
  534.     Xoffset := 0;
  535.     IF Center THEN Xoffset := (80-l) DIV 2; { Offset to "center" picture }
  536.  
  537.     FOR i := 0 TO Header.Nplanes-1 DO
  538.       BEGIN
  539.         j := i*Header.Bytes_per_line_per_plane;
  540.         t := j+l-1;
  541.         PCXline[t] := PCXline[t]AND m; { mask off unseen pixels }
  542.  
  543.         PortW[$3C4] := EGAplane+2; { set plane number }
  544.         Move(PCXline[j], EGAscreen[Y*80+Xoffset], l);
  545.         EGAplane := EGAplane SHL 1;
  546.       END;
  547.  
  548.     PortW[$3C4] := $0F02;         { default plane mask }
  549.   END;                            { ShowEGA }
  550.  
  551.  
  552.   { =========================== ShowMCGA =============================== }
  553.  
  554.   PROCEDURE ShowMCGA(Y : Integer);
  555.  
  556.     { Put a line of MCGA data on the screen }
  557.     { In Turbo Pascal, a '$' means the number is hexadeximal. }
  558.  
  559.   VAR
  560.     l : Integer;
  561.     MCGAscreen : ARRAY[0..64000] OF Byte ABSOLUTE $A000 : $0000;
  562.  
  563.   BEGIN
  564.     l := Header.Xmax-Header.Xmin; { compute number of bytes to display }
  565.     IF l > 320 THEN
  566.       l := 320;                   { don't overrun screen width }
  567.  
  568.     Xoffset := 0;
  569.     IF Center THEN Xoffset := (320-l) DIV 2; { Offset to "center" picture }
  570.  
  571.     Move(PCXline[0], MCGAscreen[Y*320+Xoffset], l);
  572.  
  573.   END;                            { ShowMCGA }
  574.  
  575.  
  576.   { =========================== Read256palette =============================== }
  577.  
  578.   PROCEDURE Read256palette;
  579.  
  580.     { Read in a 256 color palette at end of PCX file }
  581.  
  582.   VAR
  583.     i : Integer;
  584.     b : Byte;
  585.  
  586.   BEGIN
  587.     Seek(BlockFile, FileSize(BlockFile)-769);
  588.     BlockRead(BlockFile, b, 1);   { read indicator byte }
  589.     ReadError(3);
  590.  
  591.     IF b <> 12 THEN               { no palette here... }
  592.       Exit;
  593.  
  594.     BlockRead(BlockFile, Palette256, 3*256);
  595.     ReadError(3);
  596.  
  597.     Seek(BlockFile, 128);         { go back to start of PCX data }
  598.  
  599.   END;                            { Read256palette }
  600.  
  601.  
  602.   { =========================== ReadHeader =============================== }
  603.  
  604.   PROCEDURE ReadHeader;
  605.  
  606.     { Load a picture header from a PC Paintbrush PCX file }
  607.   VAR
  608.     Yoffset : Integer;
  609.  
  610.   LABEL WrongFormat;
  611.  
  612.   BEGIN
  613. {$I-}
  614.     BlockRead(BlockFile, Header, 128); { read 128 byte PCX header }
  615.     ReadError(3);
  616.  
  617.     Colors := 0;                  { To begin with }
  618.     { Is it a PCX file? }
  619.     IF (Header.Manufacturer <> 10) OR(Header.Encoding <> 1) THEN
  620.       BEGIN
  621.         Close(BlockFile);
  622.         Error('This is not a valid PCX image file.');
  623.       END;
  624.  
  625.     PicYsize := Header.Ymax-Header.Ymin+1;
  626.     PicXsize := Header.Xmax-Header.Xmin+1;
  627.  
  628.     IF (Header.Nplanes = 4) AND(Header.Bits_per_pixel = 1) THEN
  629.       BEGIN
  630.         Colors := 16;             { For both EGA and VGA }
  631.         Xsize := 640;             { X size of "default" screen }
  632.         IF (Header.Ymax-Header.Ymin) <= 199 THEN
  633.           BEGIN
  634.             PictureMode := EGA0E;
  635.             Ymax := 199;
  636.             Ysize := 200;         { Y size of "default" screen }
  637.           END
  638.         ELSE
  639.           IF (Header.Ymax-Header.Ymin) <= 349 THEN
  640.             BEGIN
  641.               PictureMode := EGA10;
  642.               Ymax := 349;
  643.               Ysize := 350;       { Y size of "default" screen }
  644.             END
  645.         ELSE
  646.           BEGIN
  647.             PictureMode := VGA12;
  648.             Ymax := 479;
  649.             Ysize := 480;         { Y size of "default" screen }
  650.           END;
  651.       END
  652.     ELSE IF (Header.Nplanes = 1) THEN
  653.       BEGIN
  654.         Ymax := 199;
  655.         Ysize := 200;             { Y size of "default" screen }
  656.  
  657.         IF (Header.Bits_per_pixel = 1) THEN
  658.           {2 Colors}
  659.           BEGIN
  660.             Colors := 2;          { 2-colors }
  661.             Xsize := 640;         { X size of "default" screen }
  662.             PictureMode := CGA06;
  663.           END
  664.           {4 Colors}
  665.         ELSE IF (Header.Bits_per_pixel = 2) THEN
  666.           BEGIN
  667.             PictureMode := CGA04;
  668.             Colors := 4;          { CGA 4-colors }
  669.             Xsize := 320;         { X size of "default" screen }
  670.           END
  671.         ELSE IF (Header.Bits_per_pixel = 8) THEN
  672.           BEGIN
  673.             PictureMode := VGA13;
  674.             Colors := 256;        { MCGA 256-colors }
  675.             Xsize := 320;         { X size of "default" screen }
  676.             IF Header.Version = 5 THEN
  677.               Read256palette;
  678.           END
  679.         ELSE
  680.           GOTO WrongFormat;
  681.       END
  682.     ELSE
  683.       BEGIN
  684. WrongFormat:
  685.         Close(BlockFile);
  686.         Error('PCX file is in wrong format - It must be a CGA, EGA, VGA, or MCGA image');
  687.       END;
  688.  
  689.     Index := 0;
  690.     NextByte := MAX_BLOCK;        { indicates no data read in yet... }
  691.  
  692.     Yoffset := 0;
  693.     IF Center THEN Yoffset := (Ymax+1-PicYsize) DIV 2;
  694.     Header.Ymax := Header.Ymax+Yoffset;
  695.     Header.Ymin := Header.Ymin+Yoffset;
  696.  
  697.   END;                            { ReadHeader }
  698.  
  699.  
  700.   { =========================== ReadByte =============================== }
  701.  
  702.   PROCEDURE ReadByte;
  703.  
  704.     { read a single byte of data - use BlockRead because it is FAST! }
  705.  
  706.   VAR
  707.     NumBlocksRead : Integer;
  708.  
  709.   BEGIN
  710.     IF NextByte = MAX_BLOCK THEN
  711.       BEGIN
  712.         BlockRead(BlockFile, BlockData, MAX_BLOCK, NumBlocksRead);
  713.         NextByte := 0;
  714.       END;
  715.  
  716.     Data := BlockData[NextByte];
  717.     Inc(NextByte);                { NextByte++; }
  718.   END;                            { ReadByte }
  719.  
  720.  
  721.   { =========================== Read_PCX_Line =============================== }
  722.  
  723.   PROCEDURE Read_PCX_Line;
  724.  
  725.     { Read a line from a PC Paintbrush PCX file }
  726.  
  727.   VAR
  728.     count : Integer;
  729.     bytes_per_line : Integer;
  730.  
  731.   BEGIN
  732. {$I-}
  733.  
  734.     bytes_per_line := Header.Bytes_per_line_per_plane*Header.Nplanes;
  735.  
  736.     { bring in any data that wrapped from previous line }
  737.     { usually none  -  this is just to be safe          }
  738.     IF Index <> 0 THEN
  739.       FillChar(PCXline[0], Index, Data); { fills a contiguous block of data }
  740.  
  741.     WHILE (Index < bytes_per_line) DO { read 1 line of data (all planes) }
  742.       BEGIN
  743.         ReadByte;
  744.  
  745.         IF (Data AND $C0) = COMPRESS_NUM THEN
  746.           BEGIN
  747.             count := Data AND $3F;
  748.             ReadByte;
  749.             FillChar(PCXline[Index], count, Data); { fills a contiguous block }
  750.             Inc(Index, count);    { Index += count; }
  751.           END
  752.         ELSE
  753.           BEGIN
  754.             PCXline[Index] := Data;
  755.             Inc(Index);           { Index++; }
  756.           END;
  757.       END;
  758.  
  759.     ReadError(3);
  760.  
  761.     Index := Index-bytes_per_line;
  762.  
  763. {$I+}
  764.   END;                            { Read_PCX_Line }
  765.  
  766.  
  767.   { =========================== Read_PCX =============================== }
  768.  
  769.   PROCEDURE Read_PCX(Name : str80);
  770.  
  771.     { Read PC Paintbrush PCX file and put it on the screen }
  772.  
  773.   VAR
  774.     k, kmax : Integer;
  775.  
  776.   BEGIN
  777. {$I-}
  778.     ImageName := Name;            { used by ReadError }
  779.  
  780.     Assign(BlockFile, Name);
  781.     Reset(BlockFile, 1);          { use 1 byte blocks }
  782.     ReadError(1);
  783.  
  784.     ReadHeader;                   { read the PCX header }
  785.  
  786.     VideoMode(PictureMode);       { switch to graphics mode }
  787.  
  788.     IF Header.Version <> 3 THEN
  789.       SetPalette;                 { set the screen palette, if available }
  790.  
  791.     kmax := Header.Ymin+Ymax;
  792.     IF Header.Ymax < kmax THEN    { don't show more than the screen can display }
  793.       kmax := Header.Ymax;
  794.  
  795.     IF (PictureMode IN[EGA0D, EGA0E, EGA10, VGA12]) THEN
  796.       BEGIN                       { 16 Colors }
  797.         FOR k := Header.Ymin TO kmax DO { each loop is separate for speed }
  798.           BEGIN
  799.             Read_PCX_Line;
  800.             ShowEGA(k);
  801.           END;
  802.       END
  803.     ELSE IF (PictureMode = VGA13) THEN
  804.       BEGIN                       { 256 Colors }
  805.         FOR k := Header.Ymin TO kmax DO
  806.           BEGIN
  807.             Read_PCX_Line;
  808.             ShowMCGA(k);
  809.           END;
  810.       END
  811.     ELSE                          { 2 or 4 Colors -- probably a CGA picture }
  812.       BEGIN
  813.         FOR k := Header.Ymin TO kmax DO
  814.           BEGIN
  815.             Read_PCX_Line;
  816.             ShowCGA(k);
  817.           END;
  818.       END;
  819.  
  820.     Close(BlockFile);
  821.     ReadError(2);
  822. {$I+}
  823.   END;                            { Read_PCX }
  824.  
  825.  
  826.   { =========================== DISPLAY_PCX =============================== }
  827.  
  828.   PROCEDURE display_pcx(Name : str80);
  829.  
  830.     { Display a PCX picture }
  831.  
  832.   VAR
  833.     c : Char;
  834.  
  835.   BEGIN
  836.  
  837.     Read_PCX(Name);               { read and display the file }
  838.  
  839.     WHILE (NOT KeyPressed) DO     { wait for any key to be pressed }
  840.       { nothing } ;
  841.  
  842.     c := ReadKey;                 { now get rid of the key that was pressed }
  843.     IF c = #0 THEN                { handle function keys }
  844.       c := ReadKey;
  845.  
  846.   END;                            { display_pcx }
  847.  
  848.  
  849.   PROCEDURE ShowPicture(PicName : str80);
  850.   VAR Spot : Integer;
  851.  
  852.   BEGIN
  853.     Center := True;               { "Center" pictures }
  854.  
  855.     ClrScr;
  856.  
  857.     UseDefaultPalette := False;
  858.     Spot := Pos('.', PicName);
  859.     IF PicName[Spot-1] = '_' THEN
  860.       UseDefaultPalette := True;
  861.     {Use Default palette if last character of picture file name is underscore}
  862.  
  863.     Name := PicName;
  864.  
  865.     IF CurrentDisplay = MonoHerc
  866.     THEN Error('PCX file is in wrong format - It must be a CGA, EGA, VGA, or MCGA image')
  867.     ELSE BEGIN                    {Valid graphics display}
  868.       display_pcx(Name);
  869.       TextMode(co80);             { back to text mode }
  870.  
  871.     END;
  872.   END;                            { ShowPicture }
  873.  
  874. BEGIN
  875.   {Empty Initialization}
  876. END.                              {Unit}
  877.